home *** CD-ROM | disk | FTP | other *** search
VERSION 5.00 Begin VB.Form fMain BorderStyle = 3 'Fixed Dialog Caption = "WidgetPad" ClientHeight = 6075 ClientLeft = 45 ClientTop = 330 ClientWidth = 8490 BeginProperty Font Name = "Tahoma" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 6075 ScaleWidth = 8490 ShowInTaskbar = 0 'False StartUpPosition = 3 'Windows Default Begin VB.ComboBox cboDirectory Height = 315 Left = 1020 Style = 2 'Dropdown List TabIndex = 3 Top = 60 Width = 5955 End Begin VB.CommandButton cmdClose Caption = "Close" Height = 375 Left = 7080 TabIndex = 2 Top = 540 Width = 1335 End Begin VB.CommandButton cmdOpen Caption = "Open..." Height = 375 Left = 7080 TabIndex = 1 Top = 120 Width = 1335 End Begin VB.TextBox txtMain Height = 5595 Left = 60 Locked = -1 'True MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 0 Top = 420 Width = 6915 End Begin VB.Label Label1 Caption = "Directory:" BeginProperty Font Name = "Tahoma" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 120 TabIndex = 4 Top = 120 Width = 855 End Attribute VB_Name = "fMain" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (ofn As OPENFILENAME) As Boolean Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (ofn As OPENFILENAME) As Boolean Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long stFilter As String stCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long strFile As String nMaxFile As Long stFileTitle As String nMaxFileTitle As Long stInitialDir As String strTitle As String flags As Long nFileOffset As Integer nFileExtension As Integer stDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type Public Enum OFN_FLAGS OFN_READONLY = &H1 OFN_OVERWRITEPROMPT = &H2 OFN_HIDEREADONLY = &H4 OFN_NOCHANGEDIR = &H8 OFN_SHOWHELP = &H10 OFN_ENABLEHOOK = &H20 OFN_ENABLETEMPLATE = &H40 OFN_ENABLETEMPLATEHANDLE = &H80 OFN_NOVALIDATE = &H100 OFN_ALLOWMULTISELECT = &H200 OFN_EXTENSIONDIFFERENT = &H400 OFN_PATHMUSTEXIST = &H800 OFN_FILEMUSTEXIST = &H1000 OFN_CREATEPROMPT = &H2000 OFN_SHAREAWARE = &H4000 OFN_NOREADONLYRETURN = &H8000 OFN_NOTESTFILECREATE = &H10000 OFN_NONETWORKBUTTON = &H20000 OFN_NOLONGNAMES = &H40000 OFN_EXPLORER = &H80000 OFN_NODEREFERENCELINKS = &H100000 OFN_LONGNAMES = &H200000 End Enum Private Const CATEGORY_ID = "{81EBBF4C-1CDA-4F96-B060-6430D99C6300}" 'Private Const CATEGORY_ID = "{DC441E1D-3ECB-4DCF-B0A5-791F9C0F4F5B}" Private Sub cmdClose_Click() Unload Me End Sub Private Sub cmdOpen_Click() Dim sFile As String Dim sFilter As String sFilter = "Widget Doc Files (*.wdoc)" & Chr$(0) & "*.WDOC" & Chr$(0) & "All Files (*.*)" & Chr$(0) & "*.*" & Chr$(0) sFile = FileOpenSave(OFN_NOCHANGEDIR, CurDir$, sFilter, , ".wdoc", , , hwnd, True) If Len(sFile) > 0 Then OpenDoc sFile End If End Sub Private Sub Form_Load() On Error GoTo Form_Load_Error LoadDirectories If Command <> "" Then OpenDoc Command End If On Error GoTo 0 Exit Sub Form_Load_Error: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Form_Load of Form fMain" End Sub Private Sub OpenDoc(FilePath As String) Dim oFS As New Scripting.FileSystemObject Dim oTS As TextStream FilePath = Replace(FilePath, Chr(34), "") Set oTS = oFS.OpenTextFile(FilePath, ForReading) txtMain.Text = oTS.ReadAll oTS.Close End Sub Public Function FileOpenSave(Optional ByRef flags As Long = 0&, Optional ByVal InitialDir As Variant, Optional ByVal Filter As String = vbNullString, Optional ByVal FilterIndex As Long = 1, Optional ByVal DefaultExt As String = vbNullString, Optional ByVal FileName As String = vbNullString, Optional ByVal DialogTitle As String = vbNullString, Optional ByVal hwnd As Long = -1, Optional ByVal OpenFile As Boolean = True) As String Dim ofn As OPENFILENAME Dim stFileName As String Dim stFileTitle As String Dim fResult As Boolean ' Give the dialog a caption title. If IsMissing(InitialDir) Then InitialDir = CurDir If (hwnd = -1) Then hwnd = 0 ' Allocate string space for the returned strings. stFileName = Left$(FileName & String$(256, vbNullChar), 256) stFileTitle = String$(256, vbNullChar) With ofn .lStructSize = Len(ofn) .hwndOwner = hwnd .stFilter = Filter .nFilterIndex = FilterIndex .strFile = stFileName .nMaxFile = Len(stFileName) .stFileTitle = stFileTitle .nMaxFileTitle = Len(stFileTitle) .strTitle = DialogTitle .flags = flags .stDefExt = DefaultExt .stInitialDir = InitialDir .hInstance = 0 .stCustomFilter = String$(255, vbNullChar) .nMaxCustFilter = 255 .lpfnHook = 0 End With If OpenFile Then fResult = GetOpenFileName(ofn) Else fResult = GetSaveFileName(ofn) End If If fResult Then flags = ofn.flags FileOpenSave = Left$(ofn.strFile, InStr(1, ofn.strFile, vbNullChar, vbBinaryCompare) - 1) End If End Function Private Sub LoadDirectories() Dim oWI As Installer Dim sTmp As Variant Set oWI = CreateObject("WindowsInstaller.Installer") cboDirectory.Clear For Each sTmp In oWI.ComponentQualifiers(CATEGORY_ID) cboDirectory.AddItem oWI.QualifierDescription(CATEGORY_ID, sTmp) Next End Sub Private Sub cboDirectory_Click() Dim oWI As Installer Dim sTmp As String Set oWI = CreateObject("WindowsInstaller.Installer") sTmp = oWI.ComponentQualifiers(CATEGORY_ID).Item(cboDirectory.ListIndex) sTmp = oWI.ProvideQualifiedComponent(CATEGORY_ID, sTmp, 0) If sTmp <> "" Then OpenDoc sTmp End Sub 
(.txt)